home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ctlsol_1 / ctlsolit.ctl (.txt) next >
Encoding:
Visual Basic Form  |  1998-05-28  |  9.7 KB  |  267 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ctlSolitaire 
  3.    BackColor       =   &H00C0FFFF&
  4.    ClientHeight    =   7155
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   7200
  8.    ScaleHeight     =   477
  9.    ScaleMode       =   3  'Pixel
  10.    ScaleWidth      =   480
  11.    Begin VB.CommandButton cmdRedo 
  12.       Caption         =   "Redo"
  13.       Height          =   495
  14.       Left            =   840
  15.       TabIndex        =   3
  16.       Top             =   6480
  17.       Width           =   615
  18.    End
  19.    Begin VB.CommandButton cmdUndo 
  20.       Caption         =   "Undo"
  21.       Height          =   495
  22.       Left            =   120
  23.       TabIndex        =   2
  24.       Top             =   6480
  25.       Width           =   615
  26.    End
  27.    Begin VB.CommandButton cmdNewGame 
  28.       Caption         =   "New Game"
  29.       Height          =   495
  30.       Left            =   5760
  31.       TabIndex        =   1
  32.       Top             =   6480
  33.       Width           =   1215
  34.    End
  35.    Begin VB.Shape shpBorder 
  36.       BorderColor     =   &H00FF0000&
  37.       BorderWidth     =   2
  38.       FillColor       =   &H00FF0000&
  39.       Height          =   495
  40.       Left            =   2280
  41.       Shape           =   3  'Circle
  42.       Top             =   360
  43.       Width           =   615
  44.    End
  45.    Begin VB.Image imgHole 
  46.       Height          =   480
  47.       Index           =   0
  48.       Left            =   360
  49.       Picture         =   "ctlSolitaire.ctx":0000
  50.       Top             =   360
  51.       Width           =   480
  52.       Visible         =   0   'False
  53.    End
  54.    Begin VB.Label lblMarblesLeft 
  55.       Alignment       =   2  'Center
  56.       BackStyle       =   0  'Transparent
  57.       Caption         =   "32"
  58.       Enabled         =   0   'False
  59.       Height          =   255
  60.       Left            =   1920
  61.       TabIndex        =   0
  62.       Top             =   480
  63.       Width           =   255
  64.    End
  65.    Begin VB.Image imgMarble 
  66.       DragMode        =   1  'Automatic
  67.       Height          =   480
  68.       Index           =   0
  69.       Left            =   1080
  70.       Picture         =   "ctlSolitaire.ctx":030A
  71.       Top             =   360
  72.       Width           =   480
  73.    End
  74. Attribute VB_Name = "ctlSolitaire"
  75. Attribute VB_GlobalNameSpace = False
  76. Attribute VB_Creatable = True
  77. Attribute VB_PredeclaredId = False
  78. Attribute VB_Exposed = True
  79. '-------------------------------------------------------------------------
  80. 'Author:    Anders Fransson
  81. 'Email:     anders.fransson@enator.se
  82. 'Internet:  http://hem1.passagen.se/fylke
  83. 'Date:      97-12-10
  84. '-------------------------------------------------------------------------
  85. Option Explicit
  86. Private m_iDragIndex As Integer
  87. Private m_iMarblesLeft As Integer
  88. Private m_iOldMovesIndex As Integer
  89. Private m_vOldMoves(1 To 2, 1 To 35) As Integer
  90. Private Const SIZE As Integer = 7
  91. Private Const HOLE_WIDTH As Integer = 50
  92. Private Const BORDER_TOP As Integer = 17
  93. Private Const BORDER_LEFT As Integer = 17
  94. Private Const BORDER_DIAMETER As Integer = 445
  95. Private Sub cmdNewGame_Click()
  96.     NewGame
  97. End Sub
  98. Private Sub cmdRedo_Click()
  99.     Redo
  100. End Sub
  101. Private Sub cmdUndo_Click()
  102.     Undo
  103. End Sub
  104. Private Sub imgHole_MouseDown(Index As Integer, Button As Integer, _
  105.     Shift As Integer, X As Single, Y As Single)
  106.     'Undo or redo move if Shift or Ctrl
  107.     If Shift = 1 Then Redo
  108.     If Shift = 2 Then Undo
  109. End Sub
  110. Private Sub UserControl_DragDrop(Source As Control, X As Single, Y As Single)
  111.     m_iDragIndex = 0
  112.     Source.Visible = True
  113. End Sub
  114. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  115.     'Undo or redo move if Shift or Ctrl
  116.     If Shift = 1 Then Redo
  117.     If Shift = 2 Then Undo
  118. End Sub
  119. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  120.     'Show last draged marble if it has been dropped outside form
  121.     If Not m_iDragIndex = 0 Then imgMarble(m_iDragIndex).Visible = True
  122. End Sub
  123. Private Sub imgMarble_DragDrop(Index As Integer, Source As Control, _
  124.     X As Single, Y As Single)
  125.     m_iDragIndex = 0
  126.     Source.Visible = True
  127. End Sub
  128. Private Sub imgMarble_DragOver(Index As Integer, Source As Control, _
  129.     X As Single, Y As Single, State As Integer)
  130.     Source.Visible = False
  131.     m_iDragIndex = Source.Index
  132. End Sub
  133. Private Static Sub imgHole_DragDrop(Index As Integer, Source As Control, _
  134.     X As Single, Y As Single)
  135.     Dim xHole%, yHole%, xSource%, ySource%
  136.     'Calculate coordinates for source-marble and drop-hole
  137.     xHole = (Index) Mod SIZE
  138.     yHole = (Index) \ SIZE
  139.     xSource = Source.Index Mod SIZE
  140.     ySource = Source.Index \ SIZE
  141.     m_iDragIndex = 0
  142.     'Show source-marble and exit sub if move isn't valid
  143.     If Not ((Abs(yHole - ySource) = 2 And (xHole = xSource)) Or _
  144.        (Abs(xHole - xSource) = 2 And (yHole = ySource))) Then
  145.         Source.Visible = True
  146.         Exit Sub
  147.     End If
  148.     PlaySound App.Path & "\Drop.wav"
  149.     'Show source-marble and exit sub if move isn't valid
  150.     If Not imgMarble((Index + Source.Index) / 2).Visible Then
  151.         Source.Visible = True
  152.         Exit Sub
  153.     End If
  154.     lblMarblesLeft.Move imgMarble((Index + Source.Index) / 2).Left + 7, _
  155.         imgMarble((Index + Source.Index) / 2).Top + 9
  156.     'Update move-menus
  157.     cmdUndo.Enabled = True
  158.     cmdRedo.Enabled = False
  159.     'Update the old-moves variable
  160.     m_iOldMovesIndex = m_iOldMovesIndex + 1
  161.     m_vOldMoves(1, m_iOldMovesIndex) = Source.Index
  162.     m_vOldMoves(2, m_iOldMovesIndex) = Index
  163.     m_vOldMoves(1, m_iOldMovesIndex + 1) = 0
  164.     m_vOldMoves(2, m_iOldMovesIndex + 1) = 0
  165.     'Hide and show involved marbles
  166.     Source.Visible = False
  167.     imgMarble((Index + Source.Index) / 2).Visible = False
  168.     imgMarble(Index).Visible = True
  169.     'Update form caption
  170.     m_iMarblesLeft = m_iMarblesLeft - 1
  171.     lblMarblesLeft = m_iMarblesLeft
  172. End Sub
  173. Private Static Sub NewGame()
  174.     Dim i%, j%
  175.     'Show marbles
  176.     For i = 0 To SIZE - 1: For j = 0 To SIZE - 1
  177.         If Not ((i < 2 And (j < 2 Or j > 4)) Or (i > 4 And (j < 2 Or j > 4))) Then _
  178.             imgMarble(i * SIZE + j).Visible = True
  179.         If (i = 3 And j = 3) Then imgMarble(i * SIZE + j).Visible = False
  180.     Next j: Next i
  181.     'Reset old-moves
  182.     For i = 1 To 2
  183.         For j = LBound(m_vOldMoves, 1) To UBound(m_vOldMoves, 1)
  184.             m_vOldMoves(i, j) = 0
  185.         Next j
  186.     Next i
  187.     'Start values
  188.     m_iDragIndex = 0
  189.     m_iOldMovesIndex = 0
  190.     m_iMarblesLeft = 32
  191.     cmdUndo.Enabled = False
  192.     cmdRedo.Enabled = False
  193.     lblMarblesLeft = m_iMarblesLeft
  194.     lblMarblesLeft.Move 231, 233
  195. End Sub
  196. Private Sub Undo()
  197.     'Exit if Undo-menu is disabled
  198.     If Not cmdUndo.Enabled Then Exit Sub
  199.     PlaySound App.Path & "\Drop.wav"
  200.     'Update form caption
  201.     m_iMarblesLeft = m_iMarblesLeft + 1
  202.     lblMarblesLeft = m_iMarblesLeft
  203.     'Update marbles visability and old-moves
  204.     imgMarble(m_vOldMoves(1, m_iOldMovesIndex)).Visible = True
  205.     imgMarble((m_vOldMoves(1, m_iOldMovesIndex) + _
  206.         m_vOldMoves(2, m_iOldMovesIndex)) / 2).Visible = True
  207.     'Plave label with marbles left
  208.     lblMarblesLeft.Move imgMarble(m_vOldMoves(2, m_iOldMovesIndex)).Left + 7, _
  209.         imgMarble(m_vOldMoves(2, m_iOldMovesIndex)).Top + 9
  210.     imgMarble(m_vOldMoves(2, m_iOldMovesIndex)).Visible = False
  211.     m_iOldMovesIndex = m_iOldMovesIndex - 1
  212.     'Disable Undo-menu if there is no more move to undo
  213.     If m_iOldMovesIndex = 0 Then cmdUndo.Enabled = False
  214.         
  215.     'Redo is now possible
  216.     cmdRedo.Enabled = True
  217. End Sub
  218. Private Sub Redo()
  219.     'Exit if Redo-menu is disabled
  220.     If Not cmdRedo.Enabled Then Exit Sub
  221.     PlaySound App.Path & "\Drop.wav"
  222.     'Update form caption
  223.     m_iMarblesLeft = m_iMarblesLeft - 1
  224.     lblMarblesLeft = m_iMarblesLeft
  225.     'Update old-moves and marbles visability
  226.     m_iOldMovesIndex = m_iOldMovesIndex + 1
  227.     imgMarble(m_vOldMoves(1, m_iOldMovesIndex)).Visible = False
  228.     imgMarble((m_vOldMoves(1, m_iOldMovesIndex) + _
  229.         m_vOldMoves(2, m_iOldMovesIndex)) / 2).Visible = False
  230.     imgMarble(m_vOldMoves(2, m_iOldMovesIndex)).Visible = True
  231.     'Plave label with marbles left
  232.     lblMarblesLeft.Move imgMarble((m_vOldMoves(1, m_iOldMovesIndex) + _
  233.         m_vOldMoves(2, m_iOldMovesIndex)) / 2).Left + 7, _
  234.         imgMarble((m_vOldMoves(1, m_iOldMovesIndex) + _
  235.         m_vOldMoves(2, m_iOldMovesIndex)) / 2).Top + 9
  236.     'Disable Redo-menu if there is no more move to redo
  237.     If m_vOldMoves(1, m_iOldMovesIndex + 1) = 0 Then cmdRedo.Enabled = False
  238.     'Undo is now possible
  239.     cmdUndo.Enabled = True
  240. End Sub
  241. Private Sub UserControl_Initialize()
  242.     Dim i%, j%
  243.     'Place border
  244.     shpBorder.Move BORDER_LEFT, BORDER_TOP, BORDER_DIAMETER, BORDER_DIAMETER
  245.     'Load and place images
  246.     imgMarble(0).Visible = False
  247.     imgMarble(0).DragIcon = imgMarble(0).Picture
  248.     For i = 0 To SIZE - 1: For j = 0 To SIZE - 1
  249.         If Not ((i < 2 And (j < 2 Or j > 4)) Or (i > 4 And (j < 2 Or j > 4))) Then
  250.             Load imgMarble(i * SIZE + j)
  251.             Load imgHole(i * SIZE + j)
  252.             imgMarble(i * SIZE + j).Move 74 + HOLE_WIDTH * j, _
  253.                 75 + HOLE_WIDTH * i
  254.             imgHole(i * SIZE + j).Move 74 + HOLE_WIDTH * j, _
  255.                 75 + HOLE_WIDTH * i
  256.             imgHole(i * SIZE + j).Visible = True
  257.         End If
  258.     Next j: Next i
  259.         
  260.     NewGame
  261. End Sub
  262. Private Sub PlaySound(strSound As String)
  263.     Dim wFlags%
  264.     wFlags% = SND_ASYNC Or SND_NODEFAULT
  265.     sndPlaySound strSound, wFlags%
  266. End Sub
  267.